home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Library / Manuels & Misc / Assembly / AOA.ZIP / CH03 / SIMX86 / PATTERNS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-20  |  9.5 KB  |  426 lines
  1. unit Patterns;
  2.  
  3. interface
  4.  
  5. type
  6.  
  7.   TPatPtr  = ^TPattern;
  8.  
  9.   mType = record case integer of
  10.  
  11.       0: (ch:char);
  12.         1:(str:PChar);
  13.         2:(cset:set of char);
  14.         3:(pat:TPatPtr);
  15.         4:(index:word);
  16.  
  17.   end;
  18.  
  19.   TPattern = record
  20.  
  21.         mf:function(Pat:TPatPtr):boolean;
  22.         m:mType;
  23.         Next:TPatPtr;
  24.         Alt:TPatPtr;
  25.         success:procedure(Pat:TPatPtr);
  26.     EndPattern:PChar;
  27.         StartPattern:PChar;
  28.  
  29.   end;
  30.  
  31.  
  32.  function match(var Pattern:TPattern; var str:PChar):boolean;
  33.  
  34.  function SpanCset(Pat:TPatPtr):Boolean;
  35.  function AnyCset(Pat:TPatPtr):Boolean;
  36.  function OneOrMoreCset(Pat:TPatPtr):Boolean;
  37.  function BrkCset(Pat:TPatPtr):Boolean;
  38.  function NotAnyCset(Pat:TPatPtr):Boolean;
  39.  function MatchStr(Pat:TPatPtr):Boolean;
  40.  function MatchiStr(Pat:TPatPtr):Boolean;
  41.  function MatchChar(Pat:TPatPtr):Boolean;
  42.  function MatchChars(Pat:TPatPtr):Boolean;
  43.  function MatchToChar(Pat:TPatPtr):Boolean;
  44.  function MatchToPat(Pat:TPatPtr):Boolean;
  45.  function ARB(Pat:TPatPtr):Boolean;
  46.  function ARBNUM(Pat:TPatPtr):Boolean;
  47.  function EOS(Pat:TPatPtr):Boolean;
  48.  function skip(Pat:TPatPtr):Boolean;
  49.  function pos(Pat:TPatPtr):Boolean;
  50.  function MatchSub(Pat:TPatPtr):Boolean;
  51.  function Succeed(Pat:TPatPtr):Boolean;
  52.  
  53.  
  54. implementation
  55.  
  56. uses SysUtils;
  57.  
  58. function match(var Pattern:TPattern; var str:PChar):boolean;
  59. begin
  60.  
  61.     Pattern.StartPattern := str;
  62.         Pattern.EndPattern := str;
  63.  
  64.         { See if the current pattern matches anything at the    }
  65.         { beginning of the current string.            }
  66.  
  67.         if (Pattern.mf(@Pattern)) then
  68.         begin
  69.  
  70.              { If we got a match, see if there is a follow-on    }
  71.              { pattern and try to match it, if so;  If no such    }
  72.              { pattern, return success.                }
  73.  
  74.              if (Pattern.Next <> NIL) then
  75.              begin
  76.  
  77.             Result := match(Pattern.Next^, Pattern.EndPattern);
  78.                 if Result then
  79.                    Pattern.EndPattern := Pattern.Next^.EndPattern;
  80.  
  81.              end
  82.              else Result := true;
  83.  
  84.              { If we've got a successful match, and "success" points    }
  85.              { at a procedure, execute that procedure.                }
  86.  
  87.              if Result and (@Pattern.Success <> NIL) then
  88.             Pattern.Success(@Pattern);
  89.  
  90.         end
  91.  
  92.         { If the pattern did not match, look for an alternate    }
  93.         { pattern and try to match it if it exists.  Return    }
  94.         { failure if there is no alternate pattern.        }
  95.  
  96.         else if (Pattern.Alt <> NIL) then
  97.         begin
  98.  
  99.             Result := match(Pattern.Alt^, Pattern.EndPattern);
  100.                 if (Result) then
  101.                    Pattern.EndPattern := Pattern.Alt^.EndPattern;
  102.         end
  103.         else Result := false;
  104.  
  105.  
  106. end;
  107.  
  108.  
  109. function MatchSub(Pat:TPatPtr):Boolean;
  110. begin
  111.  
  112.  
  113.         Result := Match(Pat^.m.Pat^, Pat^.EndPattern);
  114.         if (Result) then Pat^.EndPattern := Pat^.m.Pat^.EndPattern;
  115.  
  116. end;
  117.  
  118.  
  119. { Succeed- Always Succeeds                                         }
  120.  
  121. function Succeed(Pat:TPatPtr):Boolean;
  122. begin
  123.  
  124.         Result := true;
  125.  
  126. end;
  127. { SpanCset- This matching function skips over any characters    }
  128. {        found in the cset field.                }
  129.  
  130. function SpanCset(Pat:TPatPtr):Boolean;
  131. begin
  132.  
  133.     while (Pat^.EndPattern^ in Pat^.m.cset) do inc(Pat^.EndPattern);
  134.         Result := true;
  135.  
  136. end;
  137.  
  138.  
  139. { AnyCset-  This matching function skips over a single character}
  140. {        found in the cset field.                }
  141.  
  142. function AnyCset(Pat:TPatPtr):Boolean;
  143. begin
  144.  
  145.     Result := Pat^.EndPattern^ in Pat^.m.cset;
  146.         if Result then inc(Pat^.EndPattern);
  147.  
  148. end;
  149.  
  150.  
  151. { OneOrMoreCset- This matching function skips over any chars    }
  152. {        found in the cset field. there must be at least    }
  153. {           one character for this to succeed.                  }
  154.  
  155. function OneOrMoreCset(Pat:TPatPtr):Boolean;
  156. begin
  157.  
  158.     Result := Pat^.EndPattern^ in Pat^.m.cset;
  159.         if Result then
  160.         begin
  161.  
  162.              inc(Pat^.EndPattern);
  163.          while (Pat^.EndPattern^ in Pat^.m.cset) do
  164.                    inc(Pat^.EndPattern);
  165.         end;
  166.  
  167. end;
  168.  
  169. { BrkCset- This matching function skips over any characters    }
  170. {       that are not in the cset field.            }
  171.  
  172. function BrkCset(Pat:TPatPtr):Boolean;
  173. begin
  174.  
  175.     while  (Pat^.EndPattern^ <> #0) and
  176.             not (Pat^.EndPattern^ in Pat^.m.cset) do
  177.                    inc(Pat^.EndPattern);
  178.         Result := true;
  179.  
  180. end;
  181.  
  182. { NotAnyCset- This matching function skips over a single    }
  183. {          character that is not in the cset field.        }
  184.  
  185. function NotAnyCset(Pat:TPatPtr):Boolean;
  186. begin
  187.  
  188.     Result := (Pat^.EndPattern^ = #0) or
  189.             not (Pat^.EndPattern^ in Pat^.m.cset);
  190.         if (Result) then inc(Pat^.EndPattern);
  191.  
  192. end;
  193.  
  194. { MatchStr- Skips over the characters that match a string.    }
  195.  
  196. function MatchStr(Pat:TPatPtr):Boolean;
  197.  
  198.     function MatchPrefix(var s:PChar; t:PChar):Boolean;
  199.     var tmp:PChar;
  200.     begin
  201.  
  202.         tmp := s;
  203.         while (tmp^ = t^) and (t^ <> #0) do
  204.         begin
  205.  
  206.             inc(tmp);
  207.                 inc(t);
  208.  
  209.         end;
  210.         Result := t^ = #0;
  211.         if (Result) then s := tmp;
  212.  
  213.     end;
  214.  
  215. begin
  216.  
  217.     Result :=MatchPrefix(Pat^.EndPattern, Pat^.m.str);
  218.  
  219. end;
  220.  
  221.  
  222. { MatchiStr-    Skips over the characters that match a string,    }
  223. {        ignoring case.                    }
  224.  
  225. function MatchiStr(Pat:TPatPtr):Boolean;
  226.  
  227.     function MatchPrefix(var s:PChar; t:PChar):Boolean;
  228.     var tmp:PChar;
  229.     begin
  230.  
  231.         tmp := s;
  232.         while (upcase(tmp^) = upcase(t^)) and (t^ <> #0) do
  233.         begin
  234.  
  235.             inc(tmp);
  236.                 inc(t);
  237.  
  238.         end;
  239.         Result := t^ = #0;
  240.         if (Result) then s := tmp;
  241.  
  242.     end;
  243.  
  244. begin
  245.  
  246.     Result :=MatchPrefix(Pat^.EndPattern, Pat^.m.str);
  247.  
  248. end;
  249.  
  250.  
  251. { MatchToStr-    This function scans through the string to see    }
  252. {        if it can match some string at the current    }
  253. {        character or later in the string.        }
  254. {        This is a truly disgusting algorithm.        }
  255. {        Need to clean this one up some day.        }
  256.  
  257. function MatchToStr(Pat:TPatPtr):Boolean;
  258. var tmp:PChar;
  259. begin
  260.  
  261.     with Pat^ do
  262.     begin
  263.  
  264.         tmp := EndPattern;
  265.         while (EndPattern^ <> #0) and
  266.               not MatchStr(Pat) do inc(EndPattern);
  267.  
  268.         Result := EndPattern^ <> #0;
  269.         if not Result then EndPattern := tmp;
  270.  
  271.     end;
  272.  
  273. end;
  274.  
  275.  
  276.  
  277. { MatchChar-    Matches a single character in the string.    }
  278.  
  279. function MatchChar(Pat:TPatPtr):Boolean;
  280. begin
  281.  
  282.     Result := Pat^.EndPattern^ = Pat^.m.ch;
  283.         if Result then inc(Pat^.EndPattern);
  284.  
  285. end;
  286.  
  287. { MatchChars-    Matches zero or more occurrences of a char-    }
  288. {        acter in the string.                }
  289.  
  290. function MatchChars(Pat:TPatPtr):Boolean;
  291. begin
  292.  
  293.     while (Pat^.EndPattern^ = Pat^.m.ch) do inc(Pat^.EndPattern);
  294.         Result := true;
  295.  
  296. end;
  297.  
  298.  
  299. { MatchToChar-    Matches all characters in a string up to a    }
  300. {        specified character.  Fails if that character    }
  301. {        is not in the string.                }
  302.  
  303. function MatchToChar(Pat:TPatPtr):Boolean;
  304. var tmp:PChar;
  305. begin
  306.  
  307.     tmp := Pat^.EndPattern;
  308.         while (tmp^ <> #0) and (tmp^ <> Pat^.m.ch) do
  309.             inc (tmp);
  310.  
  311.         Result := tmp^ = Pat^.m.ch;
  312.         if (Result) then Pat^.EndPattern := tmp;
  313.  
  314. end;
  315.  
  316.  
  317.  
  318. { MatchToPat-    Matches all characters in a string up to a    }
  319. {        specified pattern.  This algorithm is a "shy"    }
  320. {        algorithm insofar is it will match as few chars    }
  321. {        as possible before matching the pattern.    }
  322. {        Also see ARB.                    }
  323.  
  324. function MatchToPat(Pat:TPatPtr):Boolean;
  325. var tmp:PChar;
  326. begin
  327.  
  328.     tmp := Pat^.EndPattern;
  329.         repeat
  330.  
  331.             Result := match(Pat^.m.pat^, tmp);
  332.                 if (not Result and (tmp^ <> #0)) then inc(tmp);
  333.  
  334.         until Result or (tmp^ = #0);
  335.         if (Result) then Pat^.EndPattern := tmp;
  336.  
  337. end;
  338.  
  339.  
  340. { ARB-        Matches all characters in a string up to a    }
  341. {        specified pattern.  This algorithm is a greedy    }
  342. {        algorithm insofar is it will match as many chars}
  343. {        as possible before matching the pattern.    }
  344. {        Also see MatchToPat.                }
  345.  
  346. function ARB(Pat:TPatPtr):Boolean;
  347. var tmp:PChar;
  348. begin
  349.  
  350.     tmp := Pat^.EndPattern;
  351.         tmp := tmp + strlen(tmp);
  352.         repeat
  353.  
  354.             Result := match(Pat^.m.pat^, tmp);
  355.                 if (not Result and (tmp <> Pat^.EndPattern)) then dec(tmp);
  356.  
  357.         until Result or (tmp = Pat^.EndPattern);
  358.         if (Result) then Pat^.EndPattern := Pat^.m.pat^.EndPattern;
  359.  
  360. end;
  361.  
  362.  
  363. { ARBNUM-    Matches an arbitrary number of strings matching    }
  364. {        the parameter pattern.                }
  365.  
  366. function ARBNUM(Pat:TPatPtr):Boolean;
  367. begin
  368.  
  369.         while (match(Pat^.m.pat^, Pat^.EndPattern)) do
  370.             Pat^.EndPattern := Pat^.m.pat^.EndPattern;
  371.         Result := true;
  372.  
  373. end;
  374.  
  375. { EOS-        Matches the end of string character (#0).    }
  376.  
  377. function EOS(Pat:TPatPtr):Boolean;
  378. begin
  379.  
  380.     Result := Pat^.EndPattern^ = #0;
  381.  
  382. end;
  383.  
  384.  
  385. { Skip-        Skips over "index" characters in the string if    }
  386. {        there are that many characters left in the str.    }
  387.  
  388. function skip(Pat:TPatPtr):Boolean;
  389. var     LastPosn,
  390.     save    :PChar;
  391. begin
  392.  
  393.         with Pat^ do begin
  394.  
  395.             save := EndPattern;
  396.             LastPosn := EndPattern + m.index;
  397.             while (EndPattern^ <> #0) and (EndPattern < LastPosn) do
  398.                 inc(EndPattern);
  399.  
  400.             Result := EndPattern^ <> #0;
  401.             if not Result then EndPattern := save;
  402.  
  403.         end;
  404. end;
  405.  
  406.  
  407. { Pos-        Returns true if the pattern matching algorithm    }
  408. {        is currently processing the character at pos-    }
  409. {        ition "index" in the string.            }
  410.  
  411. function pos(Pat:TPatPtr):Boolean;
  412. begin
  413.  
  414.     with Pat^ do begin
  415.  
  416.     Result := (EndPattern - StartPattern) = m.index;
  417.  
  418.     end;
  419. end;
  420.  
  421.  
  422.  
  423.  
  424.  
  425. end.
  426.